;;##########################################################################
;; dataobj1.lsp
;; Copyright (c) 1991-2002 by Forrest W. Young
;; Contains function to set the current data, and functions to
;; define prototype multivariate, dissim and table objects .
;; Has multivaiate data isnew method and its associated methods
;;
;; isnew and initialization methods, including:
;;
;; ISNEW, INITIALIZE-OBJECT
;; SETCD, SET-CURRENT-VARIABLES, SET-SYMBOLS
;; INFO, PRINT, OBJECT-ID, ETC
;; $VARS, $VARIABLES

;;##########################################################################




(defun setcd (&optional (object nil object?) set-menus-only &key new-data (draw t)) 
"Arg: (&optional (data-object nil object?) set-menus-only &key new-data (draw t)
When OBJECT is specified as being a data-object, sets the current data-object to DATA-OBJECT and changes system states accordingly, binding the variables *current-data*, $, and *current-object* to the new current data object, and the variables $vars, etc. to their appropriate objects. When DATA-OBJECT is not specified, reports the current object. When DATA-OBJECT is specified as NIL, hides the current object. Returns object's identification information. Only sets menu states if set-menus-only is t."

  (cond 
    ((and (not object) object?)
     (set-current-data-variables nil)
     nil)
    ((not object) *current-data*)
    (object
     (unless (or (send object :iconify) ;added this condition to replace statement at end
                 (equal "hidden" (string-downcase (send object :name))))
             (send *workmap* :no-icon-states-changing)); fwy 102199
     (WHEN *VERBOSE* (print (LIST "DATAOBJ0.LSP: ENTERING SETCD FOR" OBJECT))(force-output))
     (WHEN *VERBOSE* 
           (print (LIST "DATAOBJ0.LSP: Making Current Data" )) (force-output))
     (when (send object :iconify)
           (let* ((menu-length (send object :menu-length))
                  (current-item-number menu-length)
                  (current-icon (select (send *workmap* :data-icon-number-list)
                                        (- current-item-number 
                                           (send *workmap* :num-data-menu-items))))
                  (previconobj (send *workmap* :previously-selected-icon-object))
                  (curriconobj (send *workmap* :selected-icon-object))
                  (ds-obj (send object :datasheet-object))
                  (ds-open (current-datasheet-open))
                  (prev-dash-open) (dfn)
                  )
             (send *vista* :missing-values (send object :missing-values))
             (send delete-data-menu-item :enabled t)
             (send delete-model-menu-item :enabled nil)
             (when (not set-menus-only)
                   (send *workmap* :previously-selected-data-icon 
                         (send *workmap* :selected-data-icon))
                   (setf previous-data current-data)
                   (setf current-data object)
                   (setf current-object object)
                   (when (/= current-icon (send *workmap* :selected-icon))
                         (send *workmap* :select-icon current-icon :draw draw))
                   (send *workmap* :selected-data-icon current-icon)
                   (send *vista*   :show-labels)
                   (when (send *vista* :missing-values) 
                         (send *vista* :show-obs));PV 31/12/2001
                   (when (and (send current-data :matrices) 
                              (send current-data :mat-window))
                         (send current-data :list-matrices))
                   (send *workmap* :no-menu-marks *data-menu*))
             (send object :set-menu-item-states menu-length current-item-number 
                   current-icon ds-obj ds-open)
            ; (send *vista* :stats-menus-on) ;fwy deleted to fix diss menus 10-01-02
             (when *about-window*
                   (send *about-window* :write-text (send object :about) :show nil)
                   (send *about-window* :title      (send object :name)))
             (send *toolbox* :set-three-buttons)
         
             (when (not set-menus-only)
                   (when (and (not (send *vista* :applets)) 
                              (send *vista* :guidemap))
                         (when investigate 
                               (format t "Calling Guidance from SETCData."))
                         (guidance "data"))
                   (cond 
                     ((and ds-obj 
                           (not *realtime-datasheet-update*)
                           (send current-data :datasheet-open)
                           (send ds-obj :editable))
                      (send object :set-menu&tool-states "Disabled")
                      ;(send ds-obj :show-window) 
                         )  
                     (t 
                      (cond
                        (previous-data
                         (setf prev-dash-open 
                               (send previous-data :datasheet-object))
                         (when prev-dash-open 
                               (setf prev-dash-open 
                                        (and (send previous-data :datasheet-open)
                                             (send prev-dash-open :editable))))
                         (when (or (not (equal (send object :generalized-data-type)
                                               (send previous-data
                                                     :generalized-data-type)))
                                   prev-dash-open)
                               (send object :set-menu&tool-states 
                                     (send object :data-type))))
                        (t
                         (send object :set-menu&tool-states 
                                  (send object :data-type))))
                      ))

                   (send delete-data-menu-item :enabled t)
                   (send *workmap* :redraw-icons)
                   current-data)
             );ends let
           (when *vista-exists* (send object :set-current-data-variables))
           (send *watcher* :close)
           (WHEN *VERBOSE* (print (LIST "DATAOBJ0.LSP: EXITING SETCD FOR" OBJECT)))
	   (setf dfn (send object :datafile))
           (send *workmap* :current-object-line
                 (list (if dfn (strcat "FileName: " dfn) "FileName: UNSAVED ViSta Data Object") 
	   (strcat "DataFlow: " (send $ :dataflow-name))
	   ))
           object)) ;added current-data fwy 102199
  ))

;next two definition appear in this file below :isnew

(defun set-current-data-variables (object)
  (when (and object (not (equal "hidden" (string-downcase (send object :name)))))
        (send object :set-current-data-variables)))

(defun set-cd-symbols (object)
  (when (and object (not (equal "hidden" (string-downcase (send object :name)))))
        (send object :set-symbols)))

(defun datatype-error (a b)
  (format t
      "; error: datatype specified as ~s determined to be ~s~%" a b)
  (top-level))

(defun datatype-message (phrase type)
  (when *verbose* 
        (format t "; information: datatype ~a to be ~a~%" phrase type)))

(defun varfunc (&rest args)
	)
                       
(defun current-datasheet-open ()
  (when current-data
        (let ((ds-obj (send current-data :datasheet-object))
              )
          (when ds-obj
                (and (send current-data :datasheet-open)
                     (send ds-obj :editable))))))


(defproto mv-data-object-proto 
  '(args data title about vnames onames mnames vtypes vmenu nvar nobs var-window $
    obs-window var-window-object obs-window-object var-states obs-states 
    summary-options visualize-options menu-length icon-number ;icon-objid
    dob-parents dob-children needs-computing auto-compute freq-way-names data-type-abbrev
    guidemap-number guidemap-ancestors datasheet-object datasheet-open possible-vis-types 
    spreadplot-object simulate-parameters datasheet-arguments data-type extended-data-type
    watcher missing-values spreadplots iconify emulated-table-obj ways freq proper-name
    statistical-object-type $variables extension full-name elipsis-name bind-variables
    edited editable analyzable real-data-type subordinate datafile scroll-values
    dash-icon statobj-start-time icon-title elapsed-time object-id instance-info
    known-as-name 
;array slots follow
    array data-array array-labels array-variables freq-array array-needs-updating
;emulated table slots follow
    data-table data-table-response-variable-name new-data
    data-table-sorted-ungrouped-data-matrix level-names 
    classes nways nclasses ncells cellfreqs cell-labels source-names 
    indicator-matrices obs-labels))



;;###########################################################################
;;Define prototype dissimilarity and table data objects.
;;The defproto statements appear here so that data guidance will work 
;;even though the dissobj and tableobj files have not been loaded.

(defproto diss-data-object-proto 
  '(enames mshapes nmat nele mat-window mat-window-object mat-states) 
  () mv-data-object-proto)

(defproto table-data-object-proto 
  '(classes nways nclasses ncells cellfreqs source-names level-names 
            indicator-matrices obs-labels) 
  () mv-data-object-proto)

;;###########################################################################


(defmeth mv-data-object-proto :isnew 
                  (data-list variables title labels types name 
                        &optional freq data-type 
                        row-label column-label array new-data extension
                        all-types-in-data-array subordinate)
  (send self :slot-value 'args (list data-list variables title labels types name 
                        freq data-type 
                        row-label column-label array new-data extension
                        all-types-in-data-array subordinate))
  (unless (send self :statobj-start-time) 
            (send self :statobj-start-time (get-internal-real-time)))
  (send self :extension extension)
  (send self :subordinate subordinate)
  (when (send self :watcher)
        (send *watcher* :write-text "Initializing" :show t))
  (cond
    ((send self :matrices) ;used by diss-data based plugi
     (send self :initialize-diss-object
           data-list variables title labels types 
           (send self :matrices) (send self :shapes) (send self :element-labels)
           name extension subordinate))
    (t
     (when (send self :initialize-object 
                 data-list variables title labels types name freq)
           (when (send self :watcher)
                 (send *watcher* :write-text "Determining Datatype" :show t))
           (send self :statistical-object-type "data")
           (send self :data data-list)
           (when (not freq) (setf freq (send self :freq)))
           (if (not freq) 
               (setf freq (send self :freqclass-data?))
               (send self :freqclass-data?))
           (send self :freq freq)
;data types: 
;category class freq univariate bivariate multivariate matrix missing
           (if data-type 
               (if (not (send self :data-type))
                   (send self :data-type data-type)
                   (when (not (equal data-type (send self :data-type)))
                         (if (equal data-type "missing") 
                             (send self :data-type "missing")
                             (top-level-data-error "MV-DOB ISNEW: Conflicting data-type information"))))
               (setf data-type (send self :data-type)))
           (when new-data 
                 (setf real-data-type "new")
                 (setf data-type "missing")
                 (send self :data-type "missing")
                 )   
           (if (not (send self :data-type))
               (top-level-data-error "MV-DOB ISNEW: Incomplete data-type information."))
           (when (or (equal data-type "category") 
                     (equal data-type "class")
                     freq)
                 (when (send self :watcher)
                       (send *watcher* :write-text "Creating Array" :show t))
                 (when (or (equal data-type "category") 
                           (equal data-type "class"))
                       (send self :make-array :stuff-slots t :freq freq :on-error t
                             :all-types-in-data-array all-types-in-data-array))
                 (send self :freq-way-names (list row-label column-label))
                 (when (and freq (not (send self :array)))
                       (send self :make-array-from-2way-freq-table)
                       (setf array t))
                 (when (send self :array) (setf array t))
                 (send self :array array)
                 (when row-label (send self :array t)))
           ;next removed 5/27/99 version 5.6 to improve efficiency and
           ;reduce problems with categorical variables not meant for tables
           (when (and (equal data-type "multivariate")    
                      (> (length (send self :active-variables '(category))) 0))
                 ;next line changed to following 2 to improve efficiency and to get 
                 ;arround computing arrays with too many cells
                 ;     (send self :make-array :stuff-slots t :freq freq)
                 (send self :array t)
                 (send self :array-needs-updating t))
           (when (send self :watcher)
              	  (send *watcher* :write-text "Making Local $variables$" :show t))
           (cond
             ((equal (send self :data-type) "freq")
              (send self :summary-option-states '((0 1 3))))
             ((equal (send self :data-type) "category")
              (send self :summary-option-states '((3))))
             (t (send self :summary-option-states '((0 1)))))
           ))
    self))



; INFO, PRINT, OBJECT-ID, ETC

        

(defmeth mv-data-object-proto :known-as (&optional (name-string nil set))
  (if set (send self :known-as-name (if name-string (parse-name name-string) nil)))
  (let* ((sl (send self :known-as-name))
         (name (first sl))
         (ext (second sl))
         (ver (third  sl)))
    (cond
      ((and ext ver) (strcat name "." ext "#" (format nil "~a" ver)))
      (ext (strcat name "." ext "#" 
                   (format nil "~a" (third (get-sob-extension (strcat name "." ext))))))
      (ver (strcat name ".~#" ext))
      (t name))))

(defmeth mv-data-object-proto :print (&optional (stream *standard-output*))
"Method args: (&optional (stream *standard-output*))
Default object printing method."
  (format stream "~a" (send self :proper-name)))

(defmeth mv-data-object-proto :object-id (&optional (objid nil set))
"Message args: (&optional logical)
 Sets or retrieves the object id string."
  (when (not (slot-value 'object-id)) 
        (slot-value 'object-id (send self :make-object-id)))
  (if set (setf (slot-value 'object-id) objid))
  (slot-value 'object-id))

(defmeth mv-data-object-proto :vistatype (&optional (str nil set))
"Message args: (&optional logical)
 Sets or retrieves the object id string."
  (when (not (send self :has-slot 'vistatype))(send self :add-slot 'vistatype))
  (when (not (slot-value 'vistatype)) (slot-value 'vistatype (send self :make-vistatype)))
  (if set (setf (slot-value 'vistatype) str))
  (slot-value 'vistatype))

#|
(defmeth mv-data-object-proto :make-names (&optional name extension)
  (when (and (not name) (not (send self :name))) (fatal-message "undefined name"))
  (when (not name) (setf name (send self :name)))
  (when (not (send self :name)) 
        (send self :known-as nil)
        (send self :proper-name nil)
        (send self :name name))
  (if extension
      (send self :extension extension)
      (setf extension (send self :extension)))
  (send self :make-proper-name)
  (let* ((name-list (parse-name (send self :proper-name)))
        (L (length name-list)))
    (send self :full-name (strcat (first name-list) "#" (format nil "~a" (third name-list))))
    (when (= L 4)
          (setf L (length (fourth name-list)))
          (dotimes (i L) 
            (send self :full-name (strcat (select (fourth name-list) i) "!" (send self :full-name))))))
  (send self :elipsis-name (elipsis-name (send self :proper-name)))
  (send self :dataflow-name)
  (send self :make-dataflow-path)
  (send self :dataflow-name)
  )
|#

(defmeth mv-data-object-proto :make-names (&optional name extension)
  (when (and (not name) (not (send self :name))) (fatal-message "undefined name"))
  (when (not name) (setf name (send self :name)))
  (when (not (send self :name)) 
        (send self :known-as nil)
        (send self :proper-name nil)
        (send self :name name))
  (if extension
      (send self :extension extension)
      (setf extension (send self :extension)))
  (let* ((name-list (make-names name extension))
	)
     (send self :name (first name-list))
     (send self :full-name (second name-list))
     (send self :proper-name (third name-list))
     (send self :elipsis-name (fourth name-list))
     ;(send self :dataflow-name (fifth name-list))
     ))

(defmeth mv-data-object-proto :make-vistatype ()
  (let* ((type (string-capitalize 
                (data-type-abbreviation 
                 (send self :determine-data-type)))))
    (cond
      ((equal "matrix" (string-downcase (send self :data-type)))
       (format nil "MatrixData[~ax~ax~a:~a]" 
               (send self :nvar) (send self :nvar) (send self :nmat) (datashape? self)))
      ((send self :array)
       (format nil "~aData[~ax~a:Array]"type (send self :nobs) (send self :nvar)))
      (t
       (format nil "~aData[~ax~a]"type (send self :nobs) (send self :nvar))))))


(defmeth mv-data-object-proto :make-object-id (&key (subject nil)) 
  (format nil "#<~a: ~a   ;StatObj: ~a>"
          (if subject subject "Object")
          (if (send self :known-as)(send self :known-as)(send self :name))
          (send self :make-vistatype)))
#|see dataobj2.lsp
(defmeth mv-data-object-proto :dataflow-name ()
  (let* ((namelist (parse-name (send self :proper-name))))
    (strcat "[" (first namelist) "." (second namelist) "#"
            (format nil "~a" (third namelist)) "]"
            (send self :make-dataflow-path))))
|#

(defmeth mv-data-object-proto :make-proper-name ()
  (let* ((aka (send self :known-as)))
    (send self :proper-name nil)
    (if aka (send self :proper-name aka)
        (proper-name self))))
       
          
(defmeth mv-data-object-proto :info (&optional (stream *standard-output*)
                                               &key (verbose nil) (subject nil))
  (if (or *history* verbose)
      (unless (equal (string-downcase (send self :name)) "hidden")
              (format stream  "~%; ~a: Name:      ~a~%" 
                      (if subject subject "Object") 
                      (send self :proper-name))
              (format stream  ";         DataFile:  ~a~%" 
                      (if (not (send self :datafile))
                          (send self :datafile
                                (send *workmap* :datafile))
                          (if (send self :datafile)
                              (send self :datafile) 
                              "[Not Saved To File]")))
              (format stream  ";         StatObjct:  ~a~%" (send self :make-vistatype))
              (format stream  ";         ProtoType: ~a~%" 
                      (string-capitalize 
                       (send self :slot-value 'proto-name)))
              (format stream  ";         Address:   ~d~%" (address-of self))
              (format stream  ";         Created:   ~a~%" 
                      (send self :slot-value 'instance-info))
              (format stream  ";         Elapsed:   ~,4d seconds~%" 
                      (fuzz (send self :elapsed-time) 3)))
        (format stream "; Data:   ~a; ~a; ~,4d seconds~%> "
              (send self :proper-name) (send self :vistatype) 
                (fuzz (send self :elapsed-time) 3)))
  )
                 


; INITIALIZE OBJECT


(defmeth mv-data-object-proto :initialize-object
  (data variables title labels types name &optional freq)
"Message args: (data variables title labels types name &optional freq)
Used by isnew methods of multivariate, frequency and dissimilarity data 
objects to initialize shared aspects. Returns t if data pass 
size and shape tests, nil otherwise."
  (let* ((matdat (send self :matrices))
         (nvar (length variables))
         (nobs (if matdat
                   (* nvar (length matdat))
                   (/ (length data) nvar)))
         (remainder (rem nobs 1))) 
    (cond
      ((or 
        (and (equal remainder 0) (> nvar 0) (> nobs 0))
        matdat)
       (send self :title title)
       (send self :name name)   
       (send self :nobs nobs)
       (send self :nvar nvar)
       (send self :freq freq)
       (send self :variables variables)
       (send self :var-window nil)
       (send self :obs-window nil)
       (send self :obs-states (repeat 'NORMAL nobs))
       (send self :var-states (repeat 'NORMAL nvar))
       (send self :summary-option-states '((-1 0 1)))
       (send self :menu-length (length (send (eval *data-menu*) :items)))
       (if types (send self :types types)
           (send self :types 
                 (mapcar #'(lambda (x) 
                             (format nil "Numeric" x)) (iseq nvar))))
       (send self :labels
             (if labels (coerce labels 'list)
                 (mapcar #'(lambda (x) 
                             (format nil "Obs~a" x)) (1+ (iseq nobs))))))
      ((not (equal remainder 0))
       (error "Data are not properly shaped or are incomplete."))
      ((< nvar 1) 
       (error "The data must have at least 1 variable."))
      ((< nobs 1) 
       (error "The data must have at least 1 observation.")))
    (when (not (send self :data-type))
          (cond
            ((send self :classification-data?) (send self :data-type "class"))
            ((send self :category-data?) (send self :data-type "category"))
            ((send self :freq) (send self :data-type "freq"))
            (t (send self :data-type "multivariate"))))
    t))


; SET CURRENT VARIABLES

(defmeth mv-data-object-proto :set-current-data-variables ()
  (send self :set-symbols)
  (unless (send self :$)
          (when (send self :name)
                (set (intern (string-upcase (send self :name))) self ))
          (when (send self :full-name)
                (set (intern (string-upcase (send self :full-name))) self))
          (when (send self :proper-name)
                (set (intern (string-upcase (send self :proper-name))) self ))
          (when (send self :elipsis-name)
                (set (intern (string-upcase (send self :elipsis-name))) self ))
          (send self :$ self)
          )
  (when (and (not (send self :$variables)) 
             (not (send self :matrices))
             (not (equal "hidden" (string-downcase (send self :name)))))
        (send self :$variables
              (mapcar #'(lambda (v)	
                          (varfunc (intern (string-upcase v)) (send self :variable v)))	
                      (send self :variables))))
  (unless (send self :bind-variables) (send self :$vars))
  (setf $* (send self :$))
  (setf $.* $variables)
  (setf $variables (send self :$variables))
  (setf $vars $variables)
  (setf $datasheet (send self :datasheet-object))
  self)


(defmeth mv-data-object-proto :set-symbols () 
  (setf *cd* self)
  (setf  cd  self)
  (setf *co* self)
  (setf  co  self)
  (setf *current-data*   self)
  (setf  current-data    self)
  (setf *current-object* self)
  (setf  current-object  self)
  (setf $ self)
  (setf @ self)
  self)


; $VARS


(defmeth mv-data-object-proto :$vars ()
"$vars: Args: none
Binds symbols corresponding to the names of variables in the current data object to the variables values, if not already bound. Returns variable symbols. Adds symbols to the $vars and $data-vars lists, and creates a list named $dsobname-vars which has all of the symbols on it. Symbols created include:
$                   $     current data
name             name     data object \"name\" (the newly created data)
$variables $vars    $.*   list of all variables in current data
$data               *.    list of all data objects
$data-vars          *.*   list of all variables in all data objects
$all-vars                 list of all variables
$free-vars           .*   list of all free variables
$name-vars       name.*   list of all variables in data object name
varname                   value of variable \"varname\" in current-data
dataname#n.varname        value of variable in data-object dataname"

  (unless (or (send self :matrices)
              (send self :bind-variables))
          (send *watcher* :write-text "$vars - Getting Data Matrix")
          (let* ((dsob-name (if (send self :full-name) (send self :full-name)
                                (first (send self :get-sob-extension (send self :name)))))
                ; (short-name (send self :name))
                 (extension (send self :extension))
                 (var-names (send self :variables))
                 (datamat (send self :data-matrix))
                 (nvar (array-dimension datamat 1))
                 (global-var-names var-names)
                 (global-var-name)
                 (global-var-symbols)
                 (var-symbols)
                 (var)
                 (var-values)
                 (var-list)
                 )
             (dotimes (i nvar)
                      (send *watcher* :write-text 
                            (format nil "$vars - Binding ~a" var) :show t)
                      (setf var (blanks-to-dashes (select var-names i)))
                      (setf var-values (coerce (col datamat i) 'list))
                      (set  (intern (string-upcase var)) var-values )
                      (setf global-var-name (strcat dsob-name "." var))
                      (set  (intern (string-upcase global-var-name)) var-values )
                      (setf global-var-symbols
                            (append global-var-symbols
                                    (list (intern (string-upcase global-var-name)))))
                     ; (when (= extension 1)
                     ;       (setf global-var-name (strcat short-name "." var))
                     ;       (set (intern (string-upcase global-var-name)) var-values)
                     ;       (setf global-var-symbols
                     ;             (append global-var-symbols
                     ;                     (list (intern (string-upcase global-var-name))))))
                      (setf var-symbols 
                            (append var-symbols 
                                    (list (intern (string-upcase var))))))
             (send self :$variables var-symbols)
             (setf $ self)
             (set (intern (string-upcase dsob-name)) self)
             (setf $data (append $data (list (intern (string-upcase dsob-name)))))
             (setf $data-vars (append $data-vars global-var-symbols))
             (setf $vars var-symbols) 
             (setf $variables var-symbols)
             (setf $all-vars (append $all-vars global-var-symbols))
             (set (intern (string-upcase (strcat "$" dsob-name "-vars"))) var-symbols)
           ;  (set (intern (string-upcase (strcat "$" short-name "-vars"))) var-symbols)
             (set (intern (string-upcase (strcat "$" dsob-name ".vars"))) var-symbols)
             (set (intern (string-upcase (strcat "$" dsob-name ".*"))) var-symbols)
             (set (intern (string-upcase (strcat dsob-name ".*"))) var-symbols)
           ; (when (= 1 extension)
           ;       (set (intern (string-upcase short-name)) self)
           ;       (setf $data (append $data (list (intern (string-upcase short-name)))))
           ;       (set (intern (string-upcase (strcat "$" short-name ".vars"))) var-symbols)
           ;       (set (intern (string-upcase (strcat short-name ".*"))) var-symbols))
             (setf $.* var-symbols)
             (setf *.  $data)
             (setf *.* $data-vars)
             (setf  .* $desk-vars)
             (setf $work-vars $desk-vars)
             )
          (send *watcher* :close)
          (send self :bind-variables t)
          (send self :$variables)))


(defmeth mv-data-object-proto :make-$variables ()
  (send self :$vars))


(defun $variables (&optional (data-object *current-data*))
"$variables: Args: (&optional (data-object *current-data*))
May type $vars rather than $variables, if desired.
Binds symbols corresponding to the names of variables in data-object to the variables values, if not already bound. Returns variable symbols."
  (when data-object (send data-object :$vars)))

(defun $vars (&optional (data-object *current-data*))
"$vars: Args: (&optional (data-object *current-data*))
May type $variables rather than $vars, if desired.
Binds symbols corresponding to the names of variables in data-object to the variables values, if not already bound. Returns variable symbols."
  (when data-object (send data-object :$vars)))

;; fwy added following after 6a9 April 6, 2000
(defun $vars$ (&optional (data-object *current-data*))
"$vars: Args: (&optional (data-object *current-data*))
May type $variables rather than $vars, if desired.
Binds symbols corresponding to the names of variables in data-object to the variables values, if not already bound. Returns variable symbols."
  (when data-object (send data-object :$vars)))


;; fwy added following after 6a9 April 6, 2000

(defun vars (&optional (data-object *current-data*))
"vars: Args: (&optional (data-object *current-data*))
Binds symbols corresponding to the names of variables in data-object to the variables values, if not already bound. Returns variable symbols."
  (when data-object (send data-object :$vars)))

(defun bind-$variables (&optional (data-object *current-data*))
"Alias of $variables$"
  (when data-object (send data-object :$vars)))

(defun bind-variables (&optional (data-object *current-data*))
"Alias of $variables$"
  (when data-object (send data-object :$vars)))

